home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / RichEdit / REMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-06  |  16.0 KB  |  602 lines
  1. unit REMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ClipBrd,
  8.   ToolWin, OleRichEdit;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     MainMenu: TMainMenu;
  13.     FileNewItem: TMenuItem;
  14.     FileOpenItem: TMenuItem;
  15.     FileSaveItem: TMenuItem;
  16.     FileSaveAsItem: TMenuItem;
  17.     FilePrintItem: TMenuItem;
  18.     FileExitItem: TMenuItem;
  19.     EditUndoItem: TMenuItem;
  20.     EditCutItem: TMenuItem;
  21.     EditCopyItem: TMenuItem;
  22.     EditPasteItem: TMenuItem;
  23.     HelpContentsItem: TMenuItem;
  24.     HelpSearchItem: TMenuItem;
  25.     HelpHowToUseItem: TMenuItem;
  26.     HelpAboutItem: TMenuItem;
  27.     OpenDialog: TOpenDialog;
  28.     SaveDialog: TSaveDialog;
  29.     PrintDialog: TPrintDialog;
  30.     Ruler: TPanel;
  31.     FontDialog1: TFontDialog;
  32.     FirstInd: TLabel;
  33.     LeftInd: TLabel;
  34.     RulerLine: TBevel;
  35.     RightInd: TLabel;
  36.     N5: TMenuItem;
  37.     miEditFont: TMenuItem;
  38.     Editor: TOleRichEdit;
  39.     StatusBar: TStatusBar;
  40.     ToolBar: TToolBar;
  41.     OpenButton: TToolButton;
  42.     SaveButton: TToolButton;
  43.     PrintButton: TToolButton;
  44.     ToolButton5: TToolButton;
  45.     UndoButton: TToolButton;
  46.     CutButton: TToolButton;
  47.     CopyButton: TToolButton;
  48.     PasteButton: TToolButton;
  49.     ToolButton10: TToolButton;
  50.     FontName: TComboBox;
  51.     FontSize: TEdit;
  52.     ToolButton11: TToolButton;
  53.     UpDown1: TUpDown;
  54.     BoldButton: TToolButton;
  55.     ItalicButton: TToolButton;
  56.     UnderlineButton: TToolButton;
  57.     ToolButton16: TToolButton;
  58.     LeftAlign: TToolButton;
  59.     CenterAlign: TToolButton;
  60.     RightAlign: TToolButton;
  61.     ToolButton20: TToolButton;
  62.     BulletsButton: TToolButton;
  63.     ToolbarImages: TImageList;
  64.     Insert1: TMenuItem;
  65.     Object1: TMenuItem;
  66.  
  67.     procedure SelectionChange(Sender: TObject);
  68.     procedure FormCreate(Sender: TObject);
  69.     procedure ShowHint(Sender: TObject);
  70.     procedure FileNew(Sender: TObject);
  71.     procedure FileOpen(Sender: TObject);
  72.     procedure FileSave(Sender: TObject);
  73.     procedure FileSaveAs(Sender: TObject);
  74.     procedure FilePrint(Sender: TObject);
  75.     procedure FileExit(Sender: TObject);
  76.     procedure EditUndo(Sender: TObject);
  77.     procedure EditCut(Sender: TObject);
  78.     procedure EditCopy(Sender: TObject);
  79.     procedure EditPaste(Sender: TObject);
  80.     procedure HelpContents(Sender: TObject);
  81.     procedure HelpSearch(Sender: TObject);
  82.     procedure HelpHowToUse(Sender: TObject);
  83.     procedure HelpAbout(Sender: TObject);
  84.     procedure SelectFont(Sender: TObject);
  85.     procedure RulerResize(Sender: TObject);
  86.     procedure FormResize(Sender: TObject);
  87.     procedure FormPaint(Sender: TObject);
  88.     procedure BoldButtonClick(Sender: TObject);
  89.     procedure ItalicButtonClick(Sender: TObject);
  90.     procedure FontSizeChange(Sender: TObject);
  91.     procedure AlignButtonClick(Sender: TObject);
  92.     procedure FontNameChange(Sender: TObject);
  93.     procedure UnderlineButtonClick(Sender: TObject);
  94.     procedure BulletsButtonClick(Sender: TObject);
  95.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  96.     procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  97.       Shift: TShiftState; X, Y: Integer);
  98.     procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X,
  99.       Y: Integer);
  100.     procedure FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  101.       Shift: TShiftState; X, Y: Integer);
  102.     procedure LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  103.       Shift: TShiftState; X, Y: Integer);
  104.     procedure RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  105.       Shift: TShiftState; X, Y: Integer);
  106.     procedure FormShow(Sender: TObject);
  107.     procedure RichEditChange(Sender: TObject);
  108.     procedure FormDestroy(Sender: TObject);
  109.   private
  110.     FFileName: string;
  111.     FUpdating: Boolean;
  112.     FDragOfs: Integer;
  113.     FDragging: Boolean;
  114.     FClipboardOwner: HWnd;
  115.     function CurrText: TTextAttributes;
  116.     procedure GetFontNames;
  117.     procedure SetFileName(const FileName: String);
  118.     procedure CheckFileSave;
  119.     procedure SetupRuler;
  120.     procedure SetEditRect;
  121.     procedure UpdateCursorPos;
  122.     procedure ClipboardChanged;
  123.     procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  124.     procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN;
  125.     procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD;
  126.     procedure PerformFileOpen(const AFileName: string);
  127.     procedure SetModified(Value: Boolean);
  128.   end;
  129.  
  130. var
  131.   MainForm: TMainForm;
  132.  
  133. implementation
  134.  
  135. uses REAbout, RichEdit, ShellAPI;
  136.  
  137. const
  138.   RulerAdj = 4/3;
  139.   GutterWid = 6;
  140.  
  141. {$R *.DFM}
  142.  
  143. procedure TMainForm.SelectionChange(Sender: TObject);
  144. begin
  145.   with Editor.Paragraph do
  146.   try
  147.     FUpdating := True;
  148.     FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
  149.     LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
  150.     RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
  151.     BoldButton.Down := fsBold in Editor.SelAttributes.Style;
  152.     ItalicButton.Down := fsItalic in Editor.SelAttributes.Style;
  153.     UnderlineButton.Down := fsUnderline in Editor.SelAttributes.Style;
  154.     BulletsButton.Down := Boolean(Numbering);
  155.     FontSize.Text := IntToStr(Editor.SelAttributes.Size);
  156.     FontName.Text := Editor.SelAttributes.Name;
  157.     case Ord(Alignment) of
  158.       0: LeftAlign.Down := True;
  159.       1: RightAlign.Down := True;
  160.       2: CenterAlign.Down := True;
  161.     end;
  162.     UpdateCursorPos;
  163.   finally
  164.     FUpdating := False;
  165.   end;
  166. end;
  167.  
  168. function TMainForm.CurrText: TTextAttributes;
  169. begin
  170.   if Editor.SelLength > 0 then Result := Editor.SelAttributes
  171.   else Result := Editor.DefAttributes;
  172. end;
  173.  
  174. function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  175.   FontType: Integer; Data: Pointer): Integer; stdcall;
  176. begin
  177.   TStrings(Data).Add(LogFont.lfFaceName);
  178.   Result := 1;
  179. end;
  180.  
  181. procedure TMainForm.GetFontNames;
  182. var
  183.   DC: HDC;
  184. begin
  185.   DC := GetDC(0);
  186.   EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  187.   ReleaseDC(0, DC);
  188.   FontName.Sorted := True;
  189. end;
  190.  
  191. procedure TMainForm.SetFileName(const FileName: String);
  192. begin
  193.   FFileName := FileName;
  194.   Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]);
  195. end;
  196.  
  197. procedure TMainForm.CheckFileSave;
  198. var
  199.   SaveResp: Integer;
  200. begin
  201.   if not Editor.Modified then Exit;
  202.   SaveResp := MessageDlg(Format('Save changes to %s?', [FFileName]),
  203.     mtConfirmation, mbYesNoCancel, 0);
  204.   case SaveResp of
  205.     idYes: FileSave(Self);
  206.     idNo: {Nothing};
  207.     idCancel: Abort;
  208.   end;
  209. end;
  210.  
  211. procedure TMainForm.SetupRuler;
  212. var
  213.   I: Integer;
  214.   S: String;
  215. begin
  216.   SetLength(S, 201);
  217.   I := 1;
  218.   while I < 200 do
  219.   begin
  220.     S[I] := #9;
  221.     S[I+1] := '|';
  222.     Inc(I, 2);
  223.   end;
  224.   Ruler.Caption := S;
  225. end;
  226.  
  227. procedure TMainForm.SetEditRect;
  228. var
  229.   R: TRect;
  230. begin
  231.   with Editor do
  232.   begin
  233.     R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight);
  234.     SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  235.   end;
  236. end;
  237.  
  238. { Event Handlers }
  239.  
  240. procedure TMainForm.FormCreate(Sender: TObject);
  241. begin
  242.   Application.OnHint := ShowHint;
  243.   OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  244.   SaveDialog.InitialDir := OpenDialog.InitialDir;
  245.   SetFileName('Untitled');
  246.   GetFontNames;
  247.   SetupRuler;
  248.   SelectionChange(Self);
  249.   FClipboardOwner := SetClipboardViewer(Handle);
  250. end;
  251.  
  252. procedure TMainForm.ShowHint(Sender: TObject);
  253. begin
  254.   if Length(Application.Hint) > 0 then
  255.   begin
  256.     StatusBar.SimplePanel := True;
  257.     StatusBar.SimpleText := Application.Hint;
  258.   end
  259.   else StatusBar.SimplePanel := False;
  260. end;
  261.  
  262. procedure TMainForm.FileNew(Sender: TObject);
  263. begin
  264.   SetFileName('Untitled');
  265.   Editor.Lines.Clear;
  266.   Editor.Modified := False;
  267.   SetModified(False);
  268. end;
  269.  
  270. procedure TMainForm.PerformFileOpen(const AFileName: string);
  271. begin
  272.   Editor.Lines.LoadFromFile(AFileName);
  273.   SetFileName(AFileName);
  274.   Editor.SetFocus;
  275.   Editor.Modified := False;
  276.   SetModified(False);
  277. end;
  278.  
  279. procedure TMainForm.FileOpen(Sender: TObject);
  280. begin
  281.   CheckFileSave;
  282.   if OpenDialog.Execute then
  283.   begin
  284.     PerformFileOpen(OpenDialog.FileName);
  285.     Editor.ReadOnly := ofReadOnly in OpenDialog.Options;
  286.   end;
  287. end;
  288.  
  289. procedure TMainForm.FileSave(Sender: TObject);
  290. begin
  291.   if FFileName = 'Untitled' then
  292.     FileSaveAs(Sender)
  293.   else
  294.   begin
  295.     Editor.Lines.SaveToFile(FFileName);
  296.     Editor.Modified := False;
  297.     SetModified(False);
  298.   end;
  299. end;
  300.  
  301. procedure TMainForm.FileSaveAs(Sender: TObject);
  302. begin
  303.   if SaveDialog.Execute then
  304.   begin
  305.     if FileExists(SaveDialog.FileName) then
  306.       if MessageDlg(Format('OK to overwrite %s', [SaveDialog.FileName]),
  307.         mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
  308.     Editor.Lines.SaveToFile(SaveDialog.FileName);
  309.     SetFileName(SaveDialog.FileName);
  310.     Editor.Modified := False;
  311.     SetModified(False);
  312.   end;
  313. end;
  314.  
  315. procedure TMainForm.FilePrint(Sender: TObject);
  316. begin
  317.   if PrintDialog.Execute then
  318.     Editor.Print(FFileName);
  319. end;
  320.  
  321. procedure TMainForm.FileExit(Sender: TObject);
  322. begin
  323.   Close;
  324. end;
  325.  
  326. procedure TMainForm.EditUndo(Sender: TObject);
  327. begin
  328.   with Editor do
  329.     if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
  330. end;
  331.  
  332. procedure TMainForm.EditCut(Sender: TObject);
  333. begin
  334.   Editor.CutToClipboard;
  335. end;
  336.  
  337. procedure TMainForm.EditCopy(Sender: TObject);
  338. begin
  339.   Editor.CopyToClipboard;
  340. end;
  341.  
  342. procedure TMainForm.EditPaste(Sender: TObject);
  343. begin
  344.   Editor.PasteFromClipboard;
  345. end;
  346.  
  347. procedure TMainForm.HelpContents(Sender: TObject);
  348. begin
  349.   Application.HelpCommand(HELP_CONTENTS, 0);
  350. end;
  351.  
  352. procedure TMainForm.HelpSearch(Sender: TObject);
  353. const
  354.   EmptyString: PChar = '';
  355. begin
  356.   Application.HelpCommand(HELP_PARTIALKEY, Longint(EmptyString));
  357. end;
  358.  
  359. procedure TMainForm.HelpHowToUse(Sender: TObject);
  360. begin
  361.   Application.HelpCommand(HELP_HELPONHELP, 0);
  362. end;
  363.  
  364. procedure TMainForm.HelpAbout(Sender: TObject);
  365. begin
  366.   with TAboutBox.Create(Self) do
  367.   try
  368.     ShowModal;
  369.   finally
  370.     Free;
  371.   end;
  372. end;
  373.  
  374. procedure TMainForm.SelectFont(Sender: TObject);
  375. begin
  376.   FontDialog1.Font.Assign(Editor.SelAttributes);
  377.   if FontDialog1.Execute then
  378.     CurrText.Assign(FontDialog1.Font);
  379.   Editor.SetFocus;
  380. end;
  381.  
  382. procedure TMainForm.RulerResize(Sender: TObject);
  383. begin
  384.   RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
  385. end;
  386.  
  387. procedure TMainForm.FormResize(Sender: TObject);
  388. begin
  389.   SetEditRect;
  390.   SelectionChange(Sender);
  391. end;
  392.  
  393. procedure TMainForm.FormPaint(Sender: TObject);
  394. begin
  395.   SetEditRect;
  396. end;
  397.  
  398. procedure TMainForm.BoldButtonClick(Sender: TObject);
  399. begin
  400.   if FUpdating then Exit;
  401.   if BoldButton.Down then
  402.     CurrText.Style := CurrText.Style + [fsBold]
  403.   else
  404.     CurrText.Style := CurrText.Style - [fsBold];
  405. end;
  406.  
  407. procedure TMainForm.ItalicButtonClick(Sender: TObject);
  408. begin
  409.   if FUpdating then Exit;
  410.   if ItalicButton.Down then
  411.     CurrText.Style := CurrText.Style + [fsItalic]
  412.   else
  413.     CurrText.Style := CurrText.Style - [fsItalic];
  414. end;
  415.  
  416. procedure TMainForm.FontSizeChange(Sender: TObject);
  417. begin
  418.   if FUpdating then Exit;
  419.   CurrText.Size := StrToInt(FontSize.Text);
  420. end;
  421.  
  422. procedure TMainForm.AlignButtonClick(Sender: TObject);
  423. begin
  424.   if FUpdating then Exit;
  425.   Editor.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
  426. end;
  427.  
  428. procedure TMainForm.FontNameChange(Sender: TObject);
  429. begin
  430.   if FUpdating then Exit;
  431.   CurrText.Name := FontName.Items[FontName.ItemIndex];
  432. end;
  433.  
  434. procedure TMainForm.UnderlineButtonClick(Sender: TObject);
  435. begin
  436.   if FUpdating then Exit;
  437.   if UnderlineButton.Down then
  438.     CurrText.Style := CurrText.Style + [fsUnderline]
  439.   else
  440.     CurrText.Style := CurrText.Style - [fsUnderline];
  441. end;
  442.  
  443. procedure TMainForm.BulletsButtonClick(Sender: TObject);
  444. begin
  445.   if FUpdating then Exit;
  446.   Editor.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
  447. end;
  448.  
  449. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  450. begin
  451.   try
  452.     CheckFileSave;
  453.   except
  454.     CanClose := False;
  455.   end;
  456. end;
  457.  
  458. { Ruler Indent Dragging }
  459.  
  460. procedure TMainForm.RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  461.   Shift: TShiftState; X, Y: Integer);
  462. begin
  463.   FDragOfs := (TLabel(Sender).Width div 2);
  464.   TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs;
  465.   FDragging := True;
  466. end;
  467.  
  468. procedure TMainForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
  469.   X, Y: Integer);
  470. begin
  471.   if FDragging then
  472.     TLabel(Sender).Left :=  TLabel(Sender).Left+X-FDragOfs
  473. end;
  474.  
  475. procedure TMainForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  476.   Shift: TShiftState; X, Y: Integer);
  477. begin
  478.   FDragging := False;
  479.   Editor.Paragraph.FirstIndent := Trunc((FirstInd.Left+FDragOfs-GutterWid) / RulerAdj);
  480.   LeftIndMouseUp(Sender, Button, Shift, X, Y);
  481. end;
  482.  
  483. procedure TMainForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  484.   Shift: TShiftState; X, Y: Integer);
  485. begin
  486.   FDragging := False;
  487.   Editor.Paragraph.LeftIndent := Trunc((LeftInd.Left+FDragOfs-GutterWid) / RulerAdj)-Editor.Paragraph.FirstIndent;
  488.   SelectionChange(Sender);
  489. end;
  490.  
  491. procedure TMainForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  492.   Shift: TShiftState; X, Y: Integer);
  493. begin
  494.   FDragging := False;
  495.   Editor.Paragraph.RightIndent := Trunc((Ruler.ClientWidth-RightInd.Left+FDragOfs-2) / RulerAdj)-2*GutterWid;
  496.   SelectionChange(Sender);
  497. end;
  498.  
  499. procedure TMainForm.UpdateCursorPos;
  500. var
  501.   CharPos: TPoint;
  502. begin
  503.   CharPos.Y := SendMessage(Editor.Handle, EM_EXLINEFROMCHAR, 0,
  504.     Editor.SelStart);
  505.   CharPos.X := (Editor.SelStart -
  506.     SendMessage(Editor.Handle, EM_LINEINDEX, CharPos.Y, 0));
  507.   Inc(CharPos.Y);
  508.   Inc(CharPos.X);
  509.   StatusBar.Panels[0].Text := Format('Line: %3d   Col: %3d', [CharPos.Y, CharPos.X]);
  510.  
  511.   // update the status of the cut and copy command
  512.   CopyButton.Enabled := Editor.SelLength > 0;
  513.   EditCopyItem.Enabled := CopyButton.Enabled;
  514.   CutButton.Enabled := CopyButton.Enabled;
  515.   EditCutItem.Enabled := CopyButton.Enabled;
  516. end;
  517.  
  518. procedure TMainForm.FormShow(Sender: TObject);
  519. begin
  520.   UpdateCursorPos;
  521.   DragAcceptFiles(Handle, True);
  522.   RichEditChange(nil);
  523.   Editor.SetFocus;
  524.   ClipboardChanged;
  525.  
  526.   // check if we should load a file from the command line
  527.   if (ParamCount > 0) and FileExists(ParamStr(1)) then
  528.     PerformFileOpen(ParamStr(1));
  529. end;
  530.  
  531. procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
  532. var
  533.   CFileName: array[0..MAX_PATH] of Char;
  534. begin
  535.   try
  536.     if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
  537.     begin
  538.       CheckFileSave;
  539.       PerformFileOpen(CFileName);
  540.       Msg.Result := 0;
  541.     end;
  542.   finally
  543.     DragFinish(Msg.Drop);
  544.   end;
  545. end;
  546.  
  547. procedure TMainForm.RichEditChange(Sender: TObject);
  548. begin
  549.   SetModified(Editor.Modified);
  550.   UndoButton.Enabled := SendMessage(Editor.Handle, EM_CANUNDO, 0, 0) <> 0;
  551.   EditUndoItem.Enabled := UndoButton.Enabled;
  552. end;
  553.  
  554. procedure TMainForm.SetModified(Value: Boolean);
  555. begin
  556.   if Value then StatusBar.Panels[1].Text := 'Modified'
  557.   else StatusBar.Panels[1].Text := '';
  558. end;
  559.  
  560. procedure TMainForm.WMChangeCBChain(var Msg: TWMChangeCBChain);
  561. begin
  562.   if Msg.Remove = FClipboardOwner then FClipboardOwner := Msg.Next
  563.   else SendMessage(FClipboardOwner, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next);
  564.   Msg.Result := 0;
  565. end;
  566.  
  567. procedure TMainForm.ClipboardChanged;
  568. var
  569.   I: Integer;
  570.   Format: Word;
  571.   E: Boolean;
  572. begin
  573.   // check to see if we can paste what's on the clipboard
  574.   E := False;
  575.   for I := 0 to Clipboard.FormatCount - 1 do
  576.   begin
  577.     Format := Clipboard.Formats[I];
  578.     if SendMessage(Editor.Handle, EM_CANPASTE, Format, 0) <> 0 then
  579.     begin
  580.       E := True;
  581.       Break;
  582.     end;
  583.   end;
  584.   PasteButton.Enabled := E;
  585.   EditPasteItem.Enabled := E;
  586. end;
  587.  
  588. procedure TMainForm.WMDrawClipboard(var Msg: TWMDrawClipboard);
  589. begin
  590.   SendMessage(FClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);
  591.   Msg.Result := 0;
  592.   ClipboardChanged;
  593. end;
  594.  
  595. procedure TMainForm.FormDestroy(Sender: TObject);
  596. begin
  597.   // remove ourselves from the viewer chain
  598.   ChangeClipboardChain(Handle, FClipboardOwner);
  599. end;
  600.  
  601. end.
  602.